***
***
*** This Program already converted to Y2K
*** S&T Departement     on 29 April 1999 by Ben.Rahman
***
***
set cent on
*  FILE NAME: CASHVOID.PRG
*  BY: NURJADI PURNAMA
*  DATE: March 20, 1996
*  DESC:
*  CALLED BY:
*  DATA FILES:
SET COLO TO BG+/B,w+/n
CLEAR ALL
CLEAR
SET PROC TO SOSPRO1
SET PROC TO CASHPROC
set proc to boxproc
STORE ' ' TO AEANAME,AEAADDR,AEACITY,AEACOUN,AEACURR,AEASTNM
STORE .F. TO AEAHEAL,AEADECI,AEASITE

DO START
DR='N:'
DO screVO1
sele 1
F1='ACT_PROC.DBF'
SET EXCLU OFF
USE &DR&F1
SELE 2
F2='ACT_PHAR.DBF'
SET EXCLU OFF
USE &DR&F2
SELE 3
F3='IN_PAT'
SET EXCLU OFF
USE &DR&F3
SELE 4
F4='REVENUE'
SET EXCLU OFF
USE &DR&F4
SELE 5
F5='ACTIVITY'
SET EXCLU OFF
USE &DR&F5
SELE 6
F6='DOCT_FEE'
SET EXCLU OFF
USE &DR&F6
SELE 7
F7='PATIENT'
SET EXCLU OFF
USE &DR&F7 INDE &DR&F7
SELE 8
F8='PATJAPAN'
SET EXCLU OFF
USE &DR&F8 INDE &DR&F8

store CTOD("  /  /    ") to dobPAT,AEADAT,mdsdat,DATFIL,ENTDAT,HLST,HLEND,HLDATE
STORE SPACE(8) TO FILM,FILP,FILG
STORE SPACE(1) TO  MINIT,PATSEX,BLOODR,compin,CODTYP,CODCRE
BLOODG=SPACE(2)
store space(4) to cocod,CODDAT
store space(6) to relcod,KDPAT,NOBER
store space(25) to prgnm
JOBTELEX=SPACE(12)
store space(14) to HOMCITY,homtel,loctel,LOCCITY,HOMCOUNT,jobfax
pronam=SPACE(15)
STORE SPACE(16) TO NMPAT,FNMPAT,MNMPAT,PATNAT,JOBCITY,JOBCOUNT,JOBTEL1,JOBTEL2,JOBTEL3,mdsnbr,famrelper
STORE SPACE(16) TO NMPAT,FNMPAT,NATIO,USERNM
STORE SPACE(1) TO MNMPAT,ISEX
store space(20) to JOBPERMGR,JOBFINMGR,relper
store space(32) to LOCADD1,JOBPOSIT,conam
STORE SPACE(40) TO HOMADD,LOCADD2,jobadd2,darf
STORE SPACE(35) TO INSTYP
STORE SPACE(45) TO INSNAM
KTRR=SPACE(40)
STORE CTOD('  /  /    ') TO INSVAL
JOBADD1=SPACE(48)
homevis=.t.
lhomvis=.f.

store .f. to AEAM,PER,DOC,FAM,MDS,relper,reldoc,HL,truepat,CMS,TEMU,HEALTH,PATJAPAN,REVFIL,CHNG
STORE 0 TO REC
   PIL1=1
*   DO BOX3 WITH 10,2,"DO YOU WANT TO :","ADJUST INVOICE","VOID INVOICE","CHANGE THE PAYMENT MODE",'GR+','RB','GR+','R',PIL1,.F.,.T.
   DO BOX3 WITH 10,2,"DO YOU WANT TO :","...","VOID INVOICE","...",'GR+','RB','GR+','R',PIL1,.F.,.T.
   IF LASTKEY()=27
      RETURN
   ENDIF
   DO CASE
   CASE PIL1=2
        KT='VOID'
        SET COLO TO BG+/B,W+/N
        PIX=1
        @ 14, 2 SAY 'What is the reason : '
        @ 14,25 PROMPT 'Billed Wrongly'
        @ 15,25 PROMPT 'Patient/ Ops Request'
        @ 16,25 PROMPT 'Return Medicine'
        @ 17,25 PROMPT 'Change Medicine'
        @ 18,25 PROMPT 'System Error'
        @ 19,25 PROMPT 'Damaged Invoice'
        @ 20,25 PROMPT 'Management Request'
        @ 21,25 PROMPT 'Wrong Payment Mode'

        MENU TO PIX
        DO CASE
        CASE PIX=1
             ktrr = 'Billed Wrongly'
             kpix = '1'
        CASE PIX=2
             ktrr = 'Patient/ Ops Request'
             kpix = '2'
        CASE PIX=3
             ktrr = 'Return Medicine'
             kpix = '3'
        CASE PIX=4
             ktrr = 'Change Medicine'
             kpix = '4'
        CASE PIX=5
             ktrr = 'System Error'
             kpix = '5'
        CASE PIX=6
             ktrr = 'Damaged Invoice'
             kpix = '6'
        CASE PIX=7
             ktrr = 'Management Request'
             kpix = '7'
        CASE PIX=8
             ktrr = 'Wrong Payment Mode'
             kpix = '8'
 *            @ 21,38 GET ktrr
 *            READ
 *            kpix = 'A'
        OTHER
             RETURN
        ENDCASE
        SET COLO TO BG+/B,W+/N
        @ 9,0 CLEAR
   CASE PIL1=1
*        KT='ADJUST'
*        PIX=1
*        SET COLO TO BG+/B,W+/N
*        @ 14, 2 SAY 'What is the reason : '
*        @ 14,25 PROMPT 'WRONG MEDICAL PROCEDURES'
*        @ 15,25 PROMPT 'WRONG DRUGS/DISPOSABLE'
*        @ 16,25 PROMPT 'WRONG DOCTOR'
*        @ 17,25 PROMPT 'WRONG PARTIAL PAYMENT'
*        @ 18,25 PROMPT 'OTHER REASON'
*        MENU TO PIX
*        DO CASE
*           CASE PIX=1
*                ktrr = 'WRONG MEDICAL PROCEDURES'
*                kpix = '2'
*           CASE PIX=2
*                ktrr = 'WRONG DRUGS / DISPOSABLES'
*                kpix = '3'
*           CASE PIX=3
*                ktrr = 'WRONG DOCTOR'
*                kpix = '4'
*           CASE PIX=4
*                ktrr = 'WRONG PARTIAL PAYMENT'
*                kpix = '6'
*           CASE PIX=5
*                @ 18,38 GET ktrr
*                READ
*                kpix = 'B'
*           OTHER
                RETURN
*           ENDCASE
*        SET COLO TO BG+/B,W+/N
*        @ 9,0 CLEAR
   CASE PIL1=3
*        DO CASHM
*        IF CHNG
*           SET COLO TO BG+/B,W+/N
*           @ 19,0 CLEAR
*           DO BOXT WITH 21,23,"PLEASE RE-PRINT THE INVOICE.......",'BG+','GR',.F.,.T.
*           SET COLO TO BG+/B,W+/N
*           SET CURSOR OFF
*           WAIT ''
*           SET CURSOR ON
*        ENDIF
        RETURN
   ENDCASE
DO WHILE LASTKEY()<>27
   NOFT=SPACE(5)
   SET COLO TO GR+*/B,W+/N
   @  2,3 SAY KT
   @  4,3 SAY SUBS(KTRR,1,27)
   SET COLO TO BG+/B,W+/N
   @  4, 62  GET  NOFT PICT '@!'
   READ
   if NOFT=space(5)
      exit
   endif
   SET COLO TO BG+/B,W+/N
   F4='REVENUE'
   SELE 4
   SET EXCLU OFF
   USE &DR&F4
   GO TOP
   SWW=0
   LOCATE FOR INV_NBER=NOFT .AND. DATE_VISIT=DATE()
   DO WHILE .T.
      IF .NOT. FOUND()
         IF EOF()
            SWW=1
            EXIT
         ENDIF
         SELE 4
         CONTINUE
         LOOP
      ELSE
         IF LEFT(ALLTRIM(INV_STAT),1)='V' .OR. ALLTRIM(INV_STAT)='CR'
            SET COLO TO BG+/B*
            SET CURSOR OFF
            @ 18,17 say '>>>>> THE INVOICE NUMBER IS ALREADY VOID <<<<<'
            WAIT ' '
            SET CURSOR ON
            SET COLO TO BG+/B
            @ 15,0 CLEAR
            RETURN
         ENDIF
         DATI=DATE_VISIT
         REVFIL=.T.
         KDPAT=PAT_FILCOD
         USERNM=CASH_NAME
         EXIT
      ENDIF
   ENDDO

   IF SWW=1
      SET COLO TO BG+/B*
      SET CURSOR OFF
      @ 18,18 say '>>>>> WRONG NUMBER, PLEASE ENTER AGAIN <<<<<'
      WAIT ' '
      SET CURSOR ON
      SET COLO TO BG+/B
      @ 15,0 CLEAR
      LOOP
   ENDIF

   IF REVFIL
      SET DELE OFF
      SELE 3
      GO TOP
      LOCATE FOR PAT_FILCOD=KDPAT
      nore=recno()
      INORE=RECNO()
      KDPAT=PAT_FILCOD
      TPPAT=PAT_CODTYP
      DTPAT=PAT_CODDAT
      COPAT=PAT_CODCRP
      CRPAT=PAT_CODCRE
      NMPAT=PAT_NAME
      FNMPAT=PAT_F_NAME
      MNMPAT=PAT_M_INIT
      DENTAL=HL_DENT
      HEALTH=HEALTHLINE
      HLBEGIN=HL_START
      HLDATE=HL_END
      HLVOID=.F.
      MDSDAT=MDS_ENDATE
      INSVAL=CMS_EDAT
      CMS=PAT_CMS
      PATJAPAN=PAT_JAPAN
      IF PAT_CMS .AND. INSVAL>DATE()
         CMS=.T.
         PRGNM='CMS                      '
      ELSE
         CMS=.F.
      ENDIF
      if MED_SCHEME .and. mdsdat>date()
         mds=.t.
      else
         mds=.f.
      endif
      MDSNBR=MDS_NBER
      nore=recno()
      Inore=recno()
      perso=aeasos_per
      famil=aeasos_fam
      depper=fam_relper
      IF HEALTH .AND. (HLDATE<DATE()-15 .or. hlbegin>date())
         HLVOID=.T.
      ENDIF
      ISEX=PAT_SEX
      NATIO=PAT_NATIO
      DOBPAT=PAT_DOB
      SET DELETE ON
   ELSE
      DO CASHVOPT
      IF .NOT. TEMU
         SET COLO TO BG+/B*
         SET CURSOR OFF
         @ 18,16 say '>> THERE IS NO PATIENT CODE FOR THIS INVOICE <<'
         WAIT ' '
         SET CURSOR ON
         SET COLO TO BG+/B
         CLEAR
         RETURN
      ENDIF
   ENDIF

   SELE 4
   GO TOP
   LOCATE FOR INV_NBER=NOFT
   DATI=DATE_VISIT
   USERNM=CASH_NAME
   
   TPRO=TOTAL_PROC
   TPHA=TOTAL_PHAR
   paymode=pay_mode

   thl=total_hl
   tcash=total_cash
   tcred=total_cred
   partcash=total_cash
   partcred=total_cred

   SELE 4
   F4='VITALSGN'
   USE &DR&F4
   LOCATE FOR INV_NBER=NOFT
   SET COLO TO BG+/B,W+/N
   @ 10,1 CLEA TO 23,78
   TEMP=PAT_TEMP
   PULS=PAT_PULS
   RESP=PAT_RESP
   BPRE=PAT_BPRE
   BWEI=PAT_BWEI
   F4='REVENUE'
   SELE 4
   use &dr&f4
   TOTL=TOTAL_FEE

   SELE 1
   SET COLO TO GR+/B+
   @  4,72 SAY KDPAT
   SET COLO TO BG+/B+
   @  6,13 SAY NMPAT
   @  6,43 SAY FNMPAT
   @  6,74 SAY MNMPAT
   @  7,19 SAY DOBPAT
   @  7,43 SAY NATIO
   @  7,74 SAY ISEX
   @ 16,23 SAY "TOTAL PROCEDURE: "
   @ 16,45 SAY TPRO PICT '9,999,999.99'
   @ 18,23 SAY "TOTAL MEDICINE : "
   @ 18,45 SAY TPHA PICT '9,999,999.99'
   @ 20,23 SAY "TOTAL AMOUNT   : "
   @ 20,45 SAY TOTL PICT '9,999,999.99'

   SET CURSOR ON
   LAYA=SAVESCREEN(0,0,24,79)
   PAGE=0

   POL1=1
   DO BOX2 WITH 22,22,"DO YOU WANT TO :","CONFIRM","CANCEL",'GR+','RB','GR+','R',POL1,.F.,.T.
   IF POL1=2 .OR. LASTKEY()=27
      CLOSE ALL
      RETURN
   ENDIF
   DO WHILE LASTKEY()<>27
      IF REVFIL
         SET DELE OFF
         SELE 3
         GO INORE
         IF REC_LOCK()
            RECALL RECO INORE
         ENDIF
         UNLOCK
         SET DELETE ON
      ELSE
         SELE 3
         SET EXCLU OFF
         USE &DR&F3
         IF FIL_LOCK()
            APPEN BLANK
         ENDIF
         NORE=RECNO()
         INORE=RECNO()
         DO CASHVO20
*         GO NORE
         GO INORE
         KDPAT=PAT_FILCOD
         TPPAT=PAT_CODTYP
         DTPAT=PAT_CODDAT
         COPAT=PAT_CODCRP
         CRPAT=PAT_CODCRE
         NMPAT=PAT_NAME
         FNMPAT=PAT_F_NAME
         MNMPAT=PAT_M_INIT
         DENTAL=HL_DENT
         HEALTH=HEALTHLINE
         HLBEGIN=HL_START
         HLDATE=HL_END
         HLVOID=.F.
         MDSDAT=MDS_ENDATE
         INSVAL=CMS_EDAT
         CMS=PAT_CMS
         PATJAPAN=PAT_JAPAN
         IF PAT_CMS .AND. INSVAL>DATE()
            CMS=.T.
         ELSE
            CMS=.F.
         ENDIF
         if MED_SCHEME .and. mdsdat>date()
            mds=.t.
         else
            mds=.f.
         endif
         MDSNBR=MDS_NBER
         nore=recno()
         INORE=RECNO()
         perso=aeasos_per
         famil=aeasos_fam
         depper=fam_relper
         IF HEALTH .AND. (HLDATE<DATE()-15 .or. hlbegin>date())
            HLVOID=.T.
         ENDIF
         ISEX=PAT_SEX
         NATIO=PAT_NATIO
         DOBPAT=PAT_DOB
      ENDIF
      IF REVFIL
         DO CASHVOCD
      ELSE
         DO CASHVODD
      ENDIF
      DO CASE
      CASE PIL1=1
           DO CASHVO1
      CASE PIL1=2
           SELE 3
           GO INORE
           IF REC_LOCK()
              DELE
           ENDIF
           UNLOCK
           SET COLO TO BG+/B,W+/N
           @ 19,0 CLEAR
           DO BOXT WITH 21,25,"INVOICE ALREADY VOID",'BG+','GR',.F.,.T.
           SET COLO TO BG+/B,W+/N
           SET CURSOR OFF
           WAIT ''
           SET CURSOR ON
      ENDCASE
      EXIT
   ENDDO
   EXIT
ENDDO
return
*Formatted by: Herman T Ver. 7.1  on March 20, 1996.

